All samples

Below you can find the sample map.

library(leaflet)
library(leaflet.minicharts)
library(widgetframe)
library(sf)
library(readr)
library(dplyr)
library(RColorBrewer)
library(xfun)
library(writexl)


### prepearing the data

# convert lines to UTF-8 (replacing problematic chars)
raw_lines <- readLines("onlyMicrotus_B_MicrotusSamplesV426.txt", encoding = "latin1")

clean_lines <- iconv(raw_lines, from = "latin1", to = "UTF-8", sub = "")

# Save cleaned file
writeLines(clean_lines, "onlyMicrotus_B_MicrotusSamplesV426_cleaned.txt")

rawTable <- read_tsv("onlyMicrotus_B_MicrotusSamplesV426_cleaned.txt")
  #col_types = cols(
    #Add = col_character(),
    #Published = col_character(),
    #.default = col_guess()) # let other columns be guessed


#nrow(rawTable)
#colnames(rawTable)
cols <- c("Genus", "Species", "Samplinglocation", "Country", "Sample number (on tube or bag)", "Individual number", "Extraction y/n?", "Place of capture", "Latitude", "Longitude", "Specimen-20", "DNADNA_.Number.in..20", "RNARNA_.Number.in..80")
# Other cols: "Microsat", "Cytochrom b", "GewebeRack", "Number in Fridge oder -20C oder -80C", "Lung.Tissue", "Positive? (TULV)", "Published")

Data <- rawTable[, cols]
#View(Data)

# filter data for species "arvalis"
arvalis_data <- Data %>% filter(Species == "arvalis")

# replace non-breaking spaces (\u00A0) and any spaces around numbers in Longitude and Latitude
arvalis_data$Longitude <- gsub("\u00A0", "", arvalis_data$Longitude)
arvalis_data$Latitude  <- gsub("\u00A0", "", arvalis_data$Latitude)
# Convert coordinates to numeric if needed
arvalis_data$Longitude <- as.numeric(as.character(arvalis_data$Longitude))
arvalis_data$Latitude  <- as.numeric(as.character(arvalis_data$Latitude))
#View(arvalis_data)

# samples to add (color in red samples from locations that I plan to sequence):
add_samples <- c("MarFSi01","MarFSJ456", "MarFTr01","MarFCm04",
                 "MarFCm01","MarFM05",
                 "MarGBGGo01","MarGBGCh01","MarGBGAt04","MarGBGAe01", 
                 "MarFFo01", "MarFBe01", "MarFVi01",
                 "MarOMDo01", "MarOMGr01", "MarOMSw01", "MarOMWr01", "MarOMPs01")

# already published samples
WangHeckel2025 <- c("BSt095", "BVe061", "FBv02", "FCc02", "FDa504", "FFr549", "FGr14",
                    "FGr14", "FMc03", "FOg02", "FPi555", "FSt24", "OBSO234", "OBWs01",
               "OEOs14", "OEOs15", "OMBr149", "OMHo277", "ORGs21", "ORWa268",
               "OSaLi257", "OSaNe01", "OSJC01", "OSWi166", "OWLs033", "OWPg01")




Wang2023 <- c("BSt095", "BVe061", "FDa504", "FFr549", "FMc03", "FPi555", "Ft24",
               "FA01", "FCh05", "FTh497", "EMq03", "ESa08", "ESAv05", "FM05", "OBSO234",
               "OBWs01", "OBWs02", "OEOs14", "OEOs15", "OMBr149", "OMHo277", "OMSe194",
               "OMSO221", "OMSQ273", "ORGs21", "ORNe205", "ORWa268", "OSaLi257", "OSaNe01",
               "OSaWh256", "OSGr134", "OSJC01", "OSWi166", "OWLs033", "OWNe051", "OWPg01",
               "CHBo17", "CHVa02", "ISc01", "CZD02", "PSr06", "RuKo01", "DAb06", "DWa04", "He42")

# all published samples
published <- unique(c(WangHeckel2025, Wang2023))
published <- paste0("Mar", published)
published

arvalis_data <- arvalis_data %>%
  mutate(
    Published = `Individual number` %in% published,
    Add_marked = `Individual number` %in% add_samples)
#View(arvalis_data)

# summarise by coordinate and assign color priority
coords_summary <- arvalis_data %>%
  filter(!is.na(Latitude), !is.na(Longitude)) %>%
  group_by(Longitude, Latitude) %>%
  summarise(
    sample_count = n(),
    countries = paste(unique(Country), collapse = ", "),
    samples_info = list(
      tibble(
        sample_name = `Individual number`,
        dna = DNADNA_.Number.in..20,
        rna = RNARNA_.Number.in..80,
        Frozen_body = `Specimen-20`)),
    Location = Samplinglocation,
    has_add_sample = any(Add_marked),
    has_published = any(Published),
    color = case_when(
      has_add_sample ~ "red",
      has_published ~ "green",
      TRUE ~ "darkgrey"),
  .groups = "drop")

#View(coords_summary)

# color each sample based on presence/absence of frozen specimen or DNA/RNA
color_sample_name <- function(sample_name, Frozen_body) {
#  has_dna <- !is.na(dna) & dna != ""
#  has_rna <- !is.na(rna) & rna != ""
  has_body <- !is.na(Frozen_body) && Frozen_body != ""
  
  ### change here so that frozen body is visible
  color <- if (has_body) {"blue"}
#    if (has_dna & has_rna) {"orange"}  
#    else if (has_dna) {"blue"}
#    else if (has_rna) {"violet"}
    else {"black"}
  paste0('<span style="color:', color, ';">', sample_name, '</span>')}

coords_summary <- coords_summary %>%
  rowwise() %>%
  mutate(
    samples_colored = paste(
      sapply(1:nrow(samples_info), function(i) {
        color_sample_name(
          samples_info$sample_name[i],
          samples_info$Frozen_body[i])}),
#          samples_info$dna[i],
#          samples_info$rna[i]
      collapse = "<br>")) %>%
  ungroup()

# split into three color groups
red_dots <- coords_summary %>% filter(color == "red")
green_dots <- coords_summary %>% filter(color == "green")
grey_dots <- coords_summary %>% filter(color == "darkgrey")


### creating the map

# base map
map <- leaflet() %>%
  setView(lat = 49.76666667, lng = 0.516666667, zoom = 7) %>%
  addTiles()

# add grey dots first (bottom layer)
map <- map %>%
  addCircleMarkers(
    data = grey_dots,
    lng = ~Longitude, lat = ~Latitude,
    label = ~Location,
    color = "darkgrey",
    radius = ~5,  # + sample_count / 20,
    weight = 1, opacity = 1, fillOpacity = 0.5,
    popup = ~paste0(
      "<b>Coordinates:</b> ", Latitude, ", ", Longitude, "<br>",
      "<b>Samples at this location:</b> ", sample_count, "<br>",
      "<b>Country:</b> ", countries, "<br>",
      "<b>Location:</b> ", Location, "<br>",
      "<b>Sample IDs:</b><br>", samples_colored))
#label = ~paste0("Lat: ", Latitude, ", Lon: ", Longitude)

# add green dots (middle layer)
map <- map %>%
  addCircleMarkers(
    data = green_dots,
    lng = ~Longitude, lat = ~Latitude,
    label = ~Location,
    color = "green",
    radius = ~5,  # + sample_count / 20,
    weight = 1, opacity = 1, fillOpacity = 0.8,
    popup = ~paste0(
      "<b>Coordinates:</b> ", Latitude, ", ", Longitude, "<br>",
      "<b>Samples at this location:</b> ", sample_count, "<br>",
      "<b>Countries:</b> ", countries, "<br>",
      "<b>Location:</b> ", Location, "<br>",
      "<b>Sample IDs:</b><br>", samples_colored))

# add red dots last (top layer)
map <- map %>%
  addCircleMarkers(
    data = red_dots,
    lng = ~Longitude, lat = ~Latitude,
    label = ~Location,
    color = "red",
    radius = ~5, # + sample_count / 20
    weight = 1, opacity = 1, fillOpacity = 0.9,
    popup = ~paste0(
      "<b>Coordinates:</b> ", Latitude, ", ", Longitude, "<br>",
      "<b>Samples at this location:</b> ", sample_count, "<br>",
      "<b>Countries:</b> ", countries, "<br>",
      "<b>Location:</b> ", Location, "<br>",
      "<b>Sample IDs:</b><br>", samples_colored))

# add legends
map <- map %>%
   addLegend(
    position = "bottomleft",
    colors = c("darkgrey", "green", "red"),
    labels = c("Sampled locations", "Published (2023/2025)", "Samples to add"),
    title = "Dot color legend",
    opacity = 1) %>%
  addLegend(
    position = "topright",
    colors = "blue",  # colors = c("blue", "violet", "orange"),
    labels = "Frozen specimen at -20",  # labels = c("DNA extracted", "RNA extracted", "DNA & RNA extracted"),
    title = "Sample ID color legend",
    opacity = 1)

map